home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 12 / Amiga Plus Sonderheft Amiga 12.iso / pd / spiele / klondike_adptools / install / datas / english.lha / 5-MakeCardset.adpro < prev   
Text File  |  1997-08-22  |  11KB  |  489 lines
  1. /*
  2. ** MakeCardset.adpro :
  3. **
  4. **  This ARexx script for ADPro v2.5 or higher,
  5. **  make a Klondike cardset with the tool 'reko'.
  6. **
  7. **  Klondike & Reko Tools © Copyright Reko Productions - All Rights Reserved.
  8. **
  9. ** $VER: MakeCardset/English v2.0 (16.06.97) Copyright © 1995-97 Lejardinier Olivier - All Rights Reserved
  10. **
  11. */
  12.  
  13. /*
  14. ** ARexx Initializations.
  15. */
  16.  
  17.  ADDRESS "ADPro"
  18.  OPTIONS RESULTS
  19.  ReturnCode = 0
  20.  
  21. /*
  22. ** Parse Arguments.
  23. */
  24.  
  25.  PARSE ARG Mode
  26.  
  27. /*
  28. ** Constants Initializations.
  29. */
  30.  
  31.  NL = '0A'X
  32.  DNL = NL || NL
  33.  FALSE = 0
  34.  TRUE = 1
  35.  
  36. /*
  37. ** Strings initializations.
  38. */
  39.  
  40.  TITLE_Error = "Error :"
  41.  TITLE_Request = "Request :"
  42.  TITLE_Confirm = "Confirm :"
  43.  TITLE_Infos = "Informations :"
  44.  TITLE_SelectCardPic = "Select 1 card picture :"
  45.  
  46.  MSG_Abort = "Abort ?"
  47.  MSG_ErrorCode = "Error code ="
  48.  MSG_ADProResult = "ADPro résult ="
  49.  
  50.  MSG_UnableToSaveADProPrefs = "Unable to save ADPro prefs."
  51.  MSG_UnableToRestoreADProPrefs = "Unable to restore ADPro prefs."
  52.  
  53.  MSG_YouMustSelectCardPic = "You MUST select 1 card picture !"
  54.  MSG_UnableToLoadCardPic = "Unable to load card picture :"
  55.  MSG_CheckingCardPic = "Checking card picture :"
  56.  MSG_InvalidCardPicSize = "Invalid card picture size"
  57.  MSG_MissingCardPic = "Card picture missing !"
  58.  
  59.  MSG_PlaceCardset = "Move cardset"
  60.  MSG_Into = "to ?"
  61.  MSG_CreatingCardset = "Please wait, creating cardset"
  62.  MSG_UnableToCreateCardset = "Unable to create cardset"
  63.  MSG_DeleteCreatedCardPics = "Do you want to delete created cards pictures ?"
  64.  MSG_DeletingCardPics = "Please wait, deleting cards pictures"
  65.  MSG_YouFindCardset = "You will find cardset"
  66.  MSG_IntoDirectory = "in directory"
  67.  
  68.  GAD_Abort = "Abort"
  69.  GAD_ContinueAbort = "Continue|Abort"
  70.  GAD_SelectAbort = "Select|Abort"
  71.  GAD_Quit = "Quit"
  72.  GAD_RetrySelectAbort = "Retry|Select|Abort"
  73.  GAD_RetryAbort = "Retry|Abort"
  74.  GAD_TestAbort = "Check next|Abort"
  75.  GAD_YesNo = "Yes|No"
  76.  
  77. /*
  78. ** Save the current ADPro environment.
  79. */
  80.  
  81.  TempDefaults = "T:TempADProDefaults"
  82.  
  83.  SAVE_DEFAULTS '"'TempDefaults'"'
  84.  IF ( RC ~= 0 ) THEN
  85.   DO
  86.    Text = MSG_UnableToSaveADProPrefs || MSG_ADProError ADPRO_RESULT
  87.    OKAY1 '"'Text'"'
  88.   END
  89.  
  90. /*
  91. ** Initializations of new ADPro environment.
  92. */
  93.  
  94.  CLOSE_RENDER_SCREEN
  95.  CLEAR_RENDERED
  96.  CLEAR_RAW
  97.  PSTATUS "UNLOCKED"
  98.  DISPLAYMESSAGE '""'
  99.  ADPRO_TO_FRONT
  100.  
  101. /*
  102. ** Get a previously created card picture and check it.
  103. */
  104.  
  105.  CardPicsDir = GetPref( "KADPT.CardPicsDir" )
  106.  
  107.  IF ( ( Mode = "AUTO" ) & ( CardPicsDir ~= "" ) ) THEN
  108.   DO
  109.    CardPicsBaseName = GetPref( "KADPT.CardPicsBaseName" )
  110.    CardPicPath = AddPart( CardPicsDir, AddExt( CardPicsBaseName, "003" ) )
  111.    RetVal = CheckCardPics( CardPicPath )
  112.    IF ( ( WORD( RetVal, 1 ) ~= 55 ) & ( WORD( RetVal, 1 ) ~= 59 ) ) THEN
  113.     DO
  114.      ReturnCode = 10
  115.      CALL Quit
  116.     END
  117.   END
  118.  ELSE
  119.  DO
  120.  
  121.  Continue = FALSE
  122.  DO UNTIL ( Continue = TRUE )
  123.   
  124.   IF ( CardPicsDir ~= "" ) THEN
  125.    GETFILE '"'TITLE_SelectCardPic'"' '"'ParseDir( CardPicsDir )'"' '""'
  126.   ELSE
  127.    GETFILE '"'TITLE_SelectCardPic'"'
  128.  
  129.   IF ( RC ~= 0 ) THEN
  130.    DO
  131.     OKAYN '"'TITLE_Error'"' '"'MSG_YouMustSelectCardPic'"' '"'GAD_SelectAbort'"'
  132.     IF ( RC = 0 ) THEN
  133.      CALL ConfirmAbort
  134.    END
  135.   ELSE
  136.    DO
  137.     CardPicPath = ADPRO_RESULT
  138.     
  139.     RetVal = CheckCardPics( CardPicPath )
  140.     
  141.     IF ( ( WORD( RetVal, 1 ) = 55 ) | ( WORD( RetVal, 1 ) = 59 ) ) THEN
  142.      DO
  143.       SetPref( "KADPT.CardPicsDir", WORD( RetVal, 2 ) )
  144.       Continue = TRUE
  145.      END
  146.    END
  147.  END
  148.     
  149.  END
  150.  
  151.  CardPicsDir = WORD( RetVal, 2 )
  152.  CardPicsBaseName = WORD( RetVal, 3 )
  153.  NbCardPics = WORD( RetVal, 1 )
  154.  
  155. /*
  156. ** Free some memory.
  157. */
  158.  
  159.  CLOSE_RENDER_SCREEN
  160.  CLEAR_RENDERED
  161.  CLEAR_RAW
  162.   
  163. /*
  164. ** Get cardset destination.
  165. */
  166.  
  167.  CardsetDir = GetPref( "KADPT.CardsetDir" )
  168.  IF ( CardsetDir = "" ) THEN
  169.   CardsetDir = CardPicsDir
  170.  
  171.  Continue = FALSE
  172.  DO UNTIL ( Continue = TRUE )
  173.   Title = MSG_PlaceCardset "'" || AddExt( CardPicsBaseName, "REKO" ) || "'" MSG_Into
  174.   GETDIR '"'Title'"' '"'ParseDir( CardsetDir )'"'
  175.   IF ( RC ~= 0 ) THEN
  176.    CALL ConfirmAbort
  177.   ELSE
  178.    DO
  179.     CardsetDir = ADPRO_RESULT
  180.     Continue = TRUE
  181.    END
  182.  
  183.  END
  184.  
  185.  SetPref( "KADPT.CardsetDir", CardsetDir )
  186.  
  187. /*
  188. ** Create cardset.
  189. */
  190.  
  191.  Continue = FALSE
  192.  DO UNTIL ( Continue = TRUE ) 
  193.  
  194.   IF ( EXISTS( AddPart( CardPicsDir, "Card.REKO" ) ) ) THEN
  195.    ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardPicsDir, "Card.REKO" ) || '" FORCE QUIET'
  196.  
  197.   CardsetName = AddExt( CardPicsBaseName, "REKO" )
  198.  
  199.   Text = MSG_CreatingCardset CardsetName
  200.   DISPLAYMESSAGE '"'Text'"'
  201.  
  202.   OldDir = PRAGMA( "DIRECTORY", CardPicsDir )
  203.   OldStack = PRAGMA( "STACK", 51200 )
  204.   ADDRESS COMMAND 'C:CPU >NIL: NOCACHE'
  205.   ADDRESS COMMAND 'C:Reko >NIL:' AddExt( CardPicsBaseName, "000" ) NbCardPics
  206.   ADDRESS COMMAND 'C:CPU >NIL: CACHE'
  207.   Dummy = PRAGMA( "STACK", OldStack )
  208.   Dummy = PRAGMA( "DIRECTORY", OldDir )
  209.  
  210.   DISPLAYMESSAGE '""'
  211.  
  212.   IF ( ~EXISTS( AddPart( CardPicsDir, "Card.REKO" ) ) ) THEN
  213.    DO
  214.     Text = MSG_UnableToCreateCardset || DNL || CardsetName
  215.     OKAYN '"'TITLE_Error'"' '"'Text'"' '"'GAD_RetryAbort'"'
  216.     IF ( RC = 0 ) THEN
  217.      CALL ConfirmAbort
  218.    END
  219.   ELSE
  220.    DO
  221.     IF ( ParseDir( CardsetDir ) ~= ParseDir( CardPicsDir ) ) THEN
  222.      DO
  223.       ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardsetDir, CardsetName ) || '" FORCE QUIET'
  224.       ADDRESS COMMAND 'C:Copy >NIL: FROM="' || AddPart( CardPicsDir, "Card.REKO" ) || '" TO "' AddPart( CardsetDir, CardsetName ) || '" QUIET BUF=64'
  225.       ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardPicsDir, "Card.REKO" ) || '" FORCE QUIET'
  226.      END
  227.     ELSE
  228.      ADDRESS COMMAND 'C:Rename >NIL: FROM="' || AddPart( CardPicsDir, "Card.REKO" ) || '" AS "' || AddPart( CardsetDir, CardsetName ) || '" QUIET'
  229.  
  230.     ADDRESS COMMAND 'C:Filenote >NIL: FILE="' || AddPart( CardsetDir, CardsetName ) || '" COMMENT="Created with Klondike ADPTools © 1995-97 Lejardinier Olivier" QUIET'
  231.     
  232.     Continue = TRUE
  233.    END
  234.  END
  235.  
  236. /*
  237. ** Ask to delete created cards
  238. */
  239.  
  240.  OKAYN '"'TITLE_Request'"' '"'MSG_DeleteCreatedCardPics'"' '"'GAD_YesNo'"'
  241.  IF ( RC = 1 ) THEN
  242.   DO
  243.    DISPLAYMESSAGE '"'MSG_DeletingCardPics'"'
  244.    ADDRESS COMMAND 'C:Delete >NIL: FILE="' || AddPart( CardPicsDir, AddExt( CardPicsBaseName, "#[0-9]" ) ) || '" QUIET'
  245.    DISPLAYMESSAGE '""'
  246.   END
  247.  
  248. /*
  249. **
  250. */
  251.  
  252.  Text = MSG_YouFindCardset || DNL || AddExt( CardPicsBaseName, "REKO" ) || DNL || MSG_IntoDirectory || DNL || CardsetDir
  253.  OKAYN '"'TITLE_Infos'"' '"'Text'"' '"'GAD_Quit'"'
  254.  
  255. /*
  256. ** Quit.
  257. */
  258.  
  259. Quit:
  260.  
  261.  CLOSE_RENDER_SCREEN
  262.  CLEAR_RENDERED
  263.  CLEAR_RAW
  264.  DISPLAYMESSAGE '""'
  265.  
  266.  IF ( EXISTS( TempDefaults ) ) THEN
  267.   DO
  268.    LOAD_DEFAULTS '"'TempDefaults'"'
  269.    IF ( RC ~= 0 ) THEN
  270.     DO
  271.      Text = MSG_UnableToRestoreADProPrefs || ADProResult()
  272.      OKAY1 '"'Text'"'
  273.     END
  274.    ADDRESS COMMAND 'C:Delete >NIL: FILE="' || TempDefaults || '" QUIET'
  275.   END
  276.  
  277.  EXIT ReturnCode
  278.  
  279. RETURN
  280.  
  281. /*
  282. ** Functions.
  283. */
  284.  
  285. CheckCardPics:
  286.  
  287.  PARSE ARG CardPicPath
  288.  
  289.  RetVal = "0"
  290.  
  291.  Text = MSG_CheckingCardPic FilePart( CardPicPath )
  292.  DISPLAYMESSAGE '"'Text'"'
  293.     
  294.  LOAD_TYPE "REPLACE"
  295.  
  296.  Continue01 = FALSE
  297.  DO UNTIL ( Continue01 = TRUE )
  298.  
  299.   LOADER "IFF" CardPicPath
  300.   
  301.   IF ( RC ~= 0 ) THEN
  302.    DO
  303.     IF ( ADPRO_RESULT = "Aborted" ) THEN
  304.      CALL ConfirmAbort
  305.     ELSE
  306.      DO
  307.       Text = MSG_UnableToLoadCardPic || DNL || ParseString( CardPicPath ) || ADProResult()
  308.       IF ( Mode = "AUTO" ) THEN
  309.        Gad = GAD_RetryAbort
  310.       ELSE
  311.        Gad = GAD_RetrySelectAbort
  312.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
  313.       IF ( RC = 0 ) THEN
  314.        CALL ConfirmAbort "NOCHECK"
  315.       ELSE
  316.        IF ( RC = 2 ) THEN
  317.         Continue01 = TRUE
  318.      END
  319.    END
  320.   ELSE
  321.    DO
  322.     XSIZE
  323.     CardPicWidth = ADPRO_RESULT
  324.  
  325.     YSIZE
  326.     CardPicHeight = ADPRO_RESULT
  327.  
  328.     IF ( ( CardPicWidth = 88 ) & ( CardPicHeight = 130 ) ) THEN
  329.      DO
  330.       CardPicsDir = DirPart( CardPicPath )
  331.       CardPicsBaseName = DelExt( FilePart( CardPicPath ) )
  332.  
  333.       Continue02 = TRUE
  334.       NbCardPics = 0
  335.       Extension = 0
  336.  
  337.       DO UNTIL ( Continue02 = FALSE )
  338.        FileExtension = RIGHT( Extension, 3, '0' )
  339.        CardPicPath = AddPart( CardPicsDir, AddExt( CardPicsBaseName, FileExtension ) )
  340.        Text = MSG_CheckingCardPic FilePart( CardPicPath )
  341.        DISPLAYMESSAGE '"'Text'"'
  342.        IF ( EXISTS( CardPicPath ) ) THEN
  343.         DO
  344.          NbCardPics = NbCardPics + 1
  345.          Extension = Extension + 1
  346.         END
  347.        ELSE
  348.         Continue02 = FALSE
  349.       END
  350.  
  351.       DISPLAYMESSAGE '""'
  352.        
  353.       IF ( ( NbCardPics = 55 ) | ( NbCardPics = 59 ) ) THEN
  354.        DO
  355.         RetVal = NbCardPics CardPicsDir CardPicsBaseName
  356.         Continue01 = TRUE
  357.        END
  358.       ELSE
  359.        DO
  360.         Text = MSG_MissingCardPic || DNL || CardPicPath
  361.         IF ( Mode = "AUTO" ) THEN
  362.          Gad = GAD_Abort
  363.         ELSE
  364.          Gad = GAD_SelectAbort
  365.         OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
  366.         IF ( RC = 0 ) THEN
  367.          CALL ConfirmAbort "NOCHECK"
  368.         Continue01 = TRUE
  369.        END
  370.      END
  371.     ELSE
  372.      DO
  373.       Text = MSG_InvalidCardPicSize || DNL || CardPicPath
  374.       IF ( Mode = "AUTO" ) THEN
  375.        Gad = GAD_Abort
  376.       ELSE
  377.        Gad = GAD_SelectAbort
  378.       OKAYN '"'TITLE_Error'"' '"'Text'"' '"'Gad'"'
  379.       IF ( RC = 0 ) THEN
  380.        CALL ConfirmAbort "NOCHECK"
  381.       Continue01 = TRUE
  382.      END
  383.    END
  384.  END
  385.  
  386. RETURN RetVal
  387.  
  388. /*
  389. ** Sub Routines
  390. */
  391.  
  392. ADProResult:
  393.  ADProResultText = DNL || MSG_ErrorCode RC || NL || MSG_ADProResult ADPRO_RESULT
  394. RETURN ADProResultText
  395.  
  396. ConfirmAbort:
  397.  
  398.  PARSE ARG Check
  399.  
  400.  IF ( ( Mode = "AUTO" ) & ( Check = "NOCHECK" ) ) THEN
  401.   DO
  402.    ReturnCode = 20
  403.    CALL Quit
  404.   END
  405.  ELSE
  406.   DO
  407.    OKAYN '"'TITLE_Confirm'"' '"'MSG_Abort'"' '"'GAD_ContinueAbort'"'
  408.    IF ( RC = 0 ) THEN
  409.     DO
  410.      ReturnCode = 20
  411.      CALL Quit
  412.     END
  413. RETURN
  414.  
  415. ParseString: PROCEDURE
  416.  PARSE ARG String
  417. RETURN STRIP( String, 'B', '"' )
  418.  
  419. ParseDir: PROCEDURE
  420.  PARSE ARG Dir
  421.  Dir = ParseString( Dir )
  422.  Dir = STRIP( Dir, 'T', '/' )
  423. RETURN Dir
  424.  
  425. DirPart: PROCEDURE
  426.  PARSE ARG Path
  427.  Path = ParseString( Path )
  428.  FNameSepPos = LASTPOS( '/', Path )
  429.  IF ( FNameSepPos = 0 ) THEN
  430.   RETURN LEFT( Path, LASTPOS( ':', Path ) )
  431.  ELSE
  432.   RETURN LEFT( Path, FNameSepPos - 1 )
  433.  
  434. FilePart:
  435.  PARSE ARG Path
  436.  Path = ParseString( Path )
  437.  FNameSepPos = LASTPOS( '/', Path )
  438.  IF ( FNameSepPos = 0 ) THEN
  439.   FNameSepPos = LASTPOS( ':', Path )
  440. RETURN RIGHT( Path, LENGTH( Path ) - FNameSepPos )
  441.  
  442. AddPart:
  443.  PARSE ARG Dir, Name
  444.  LastChar = RIGHT( Dir, 1 )
  445.  IF (( LastChar ~= "/" ) & ( LastChar ~= ":" )) THEN
  446.   Dir = Dir || "/"
  447. RETURN Dir || Name
  448.  
  449. AddExt:
  450.  PARSE ARG Name, Ext
  451. RETURN Name || "." || Ext
  452.  
  453. DelExt:
  454.  PARSE ARG Name
  455.  PointPos = LASTPOS( '.', Name )
  456.  if ( PointPos ~= 0 ) THEN
  457.   Name = DELSTR( Name, PointPos )
  458. RETURN Name
  459.  
  460. GetPref: PROCEDURE
  461.  PARSE ARG Name
  462.  
  463.  Pref = GETCLIP( Name )
  464.  IF ( Pref = "" ) THEN
  465.   DO
  466.    IF ( OPEN( FileHandle, AddPart( "ENVARC:Klondike_ADPTools", Name ), "READ" ) ) THEN
  467.     DO
  468.      Pref = READLN( FileHandle )
  469.      Dummy = CLOSE( FileHandle )
  470.     END
  471.   END
  472. RETURN Pref
  473.  
  474. SetPref: PROCEDURE
  475.  PARSE ARG Name, Pref
  476.  
  477.  Dummy = SETCLIP( Name, Pref )
  478.  
  479.  IF ( ~EXISTS( "ENVARC:Klondike_ADPTools" ) ) THEN
  480.   ADDRESS COMMAND 'C:MakeDir >NIL: ENVARC:Klondike_ADPTools'
  481.   
  482.  IF ( OPEN( FileHandle, AddPart( "ENVARC:Klondike_ADPTools", Name ), "WRITE" ) ) THEN
  483.   DO
  484.    Dummy = WRITELN( FileHandle, Pref )
  485.    Dummy = CLOSE( FileHandle )
  486.   END
  487. RETURN Pref
  488.  
  489.